home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / apidev / q_srvr.arc / Q1.PAS next >
Pascal/Delphi Source File  |  1989-09-07  |  22KB  |  1,042 lines
  1. Program Queue_Server_Demo;
  2.  
  3. {
  4.   This is a Queue Server demo program.
  5.  
  6.   This utility will create Queue (if it doesn't exist already) to be
  7.   serviced.  As part of creating the Queue the user SUPERVISOR will be
  8.   added as a Q_SERVER...doing this requires the SUPERVISOR to be logged in
  9.   at the station performing the Queue functions...this is not the only way
  10.   to do this, another user could be used.
  11.  
  12.   After the Queue is created it will be attached to and the Queue server
  13.   status will be set.  This status is just an FYI field that can be used
  14.   to indicate whatever to the Queue's clients.
  15.  
  16.   Next the Queue server will attempt to service a queue job if one exists.
  17.  
  18.   For purposes of this demo the Queue Server will take the job and read it
  19.   as such:
  20.   byte  0     = logical station number
  21.   bytes 1..56 = message to send
  22.  
  23.   Next the Queue server will finish servicing the queue job and attempt to
  24.   service another job.
  25.  
  26.   If the human Queue Server user stops the Queue Server it will detach itself
  27.   from the queue it is servicing.
  28.  
  29.   Note that up to 25 Queue Servers can service a single queue simultaneously.
  30.  
  31.   note that this utility does not do extensive error checking, for instance,
  32.   if a bad file handle is returned on the open NETQ operation, this program
  33.   will be none the wiser...remember these routines are to show how to
  34.   perform basic queue server operations (a skeleton queue server if you will)
  35.   not how to perform comprehensive error checking...
  36.  
  37.   by: John T. McCann
  38.       9/7/89
  39. }
  40.  
  41.  
  42. Uses Dos, Crt;
  43.  
  44.  
  45. Type
  46.  
  47.  
  48.  char60    = array[0..60] of byte;
  49.  
  50.  Long      = record
  51.               a,b,c,d : byte;
  52.              end;
  53.  
  54.  
  55.  MyWord    = record
  56.               wh,wl : byte
  57.              end;
  58.  
  59.  
  60. e364c      = record
  61.               native : MyWord;
  62.               func   : byte; { will be 0x64, Create Queue }
  63.               Qtype  : MyWord;
  64.               QnameL : byte;
  65.               Qname  : array[1..4] of byte; { can be up to 47 }
  66.                                             { for purposes here I am using }
  67.                                             { the fixed name "DEMO" }
  68.               dirhnd : byte;
  69.               pathL  : byte; { 1..118 }
  70.               pathN  : array[1..20] of byte;
  71.              end;
  72.  
  73. e364r      = record
  74.               native : MyWord;
  75.               Qid    : Long;
  76.              end;
  77.  
  78.  
  79. e335c      = record
  80.               native : MyWord;
  81.               func   : byte; { will be 0x35, Get an Object's Number }
  82.               objtyp : MyWord;
  83.               objnml : byte;
  84.               objnme : array[1..4] of byte; {DEMO}
  85.              end;
  86.  
  87. e335r      = record
  88.               native : MyWord;
  89.               Qid    : Long;
  90.               objtyp : MyWord;
  91.               objnme : array[1..48] of byte;
  92.              end;
  93.  
  94.  
  95. e341c      = record
  96.               native : MyWord;
  97.               func   : byte; { will be 0x41, Add a member to a property set }
  98.               objtyp : MyWord;
  99.               objnml : byte;
  100.               objnme : array[1..4] of byte; { using name DEMO per above }
  101.               propl  : byte;
  102.               propn  : array[1..9] of byte; { Q_SERVERS }
  103.               memtyp : MyWord;
  104.               memnml : byte;
  105.               memnme : array[1..10] of byte; { SUPERVISOR }
  106.              end;
  107.  
  108. e341r      = record
  109.               native : MyWord;
  110.               junk   : byte;
  111.              end;
  112.  
  113.  
  114. e341Ec     = record
  115.               native : MyWord;
  116.               func   : byte; { will be 0x41, Add a member to a property set }
  117.               objtyp : MyWord;
  118.               objnml : byte;
  119.               objnme : array[1..4] of byte; { using name DEMO per above }
  120.               propl  : byte;
  121.               propn  : array[1..7] of byte; { Q_USERS }
  122.               memtyp : MyWord;
  123.               memnml : byte;
  124.               memnme : array[1..8] of byte; { EVERYONE }
  125.              end;
  126.  
  127. e341Er     = record
  128.               native : MyWord;
  129.               junk   : byte;
  130.              end;
  131.  
  132.  
  133. e36fc      = record
  134.               native : MyWord;
  135.               func   : byte; { will be 0x6F, Attach Queue Server to Queue }
  136.               Qid    : Long;
  137.              end;
  138.  
  139. e36fr      = record
  140.               native : MyWord;
  141.               junk   : byte;
  142.              end;
  143.  
  144.  
  145. e377c      = record
  146.               native : MyWord;
  147.               func   : byte; { will be 0x77, Set Queue Server Current Status }
  148.               Qid    : Long;
  149.               charge : array[1..4] of byte;
  150.               status : string[59];
  151.              end;
  152.  
  153. e377r      = record
  154.               native : MyWord;
  155.               junk   : byte;
  156.              end;
  157.  
  158.  
  159. e36bc      = record
  160.               native : MyWord;
  161.               func   : byte; { will be 0x6B, Get Queue Job List }
  162.               Qid    : Long;
  163.              end;
  164.  
  165. e36br      = record
  166.               native : MyWord;
  167.               jobcnt : MyWord;
  168.               jobnum : array[1..250] of MyWord; { actual length is based on }
  169.                                                 { jobcnt }
  170.               maxjnm : MyWord;
  171.              end;
  172.  
  173.  
  174. e371c      = record
  175.               native : MyWord;
  176.               func   : byte; { will be 0x71, Service Queue Job and Open File }
  177.               Qid    : Long;
  178.               Target : MyWord; { will be 0xFFFF, all job types }
  179.              end;
  180.  
  181. e371r      = record
  182.               native : MyWord;
  183.               cltnst : byte;
  184.               clttnm : byte;
  185.               cltID  : Long;
  186.               tsID   : Long;
  187.               texect : array[1..6] of byte;
  188.               jobent : array[1..6] of byte;
  189.               jobnum : MyWord;
  190.               jobtyp : MyWord;
  191.               jobpos : byte;
  192.               jobcfl : byte;
  193.               jobfln : array[1..14] of byte;
  194.               jobflh : array[1..6] of byte;
  195.               srvstn : byte;
  196.               srvtsk : byte;
  197.               srvID  : Long;
  198.              end;
  199.  
  200.  
  201. e372c      = record
  202.               native : MyWord;
  203.               func   : byte; { will be 0x72, Finish Servicing Queue Job and File }
  204.               Qid    : Long;
  205.               jobnum : MyWord;
  206.               charge : Long;
  207.              end;
  208.  
  209. e372r      = record
  210.               native : MyWord;
  211.               junk   : byte;
  212.              end;
  213.  
  214.  
  215. e370c      = record
  216.               native : MyWord;
  217.               func   : byte; { will be 0x70, Detach Queue Server from Queue }
  218.               Qid    : Long;
  219.              end;
  220.  
  221. e370r      = record
  222.               native : MyWord;
  223.               junk   : byte;
  224.              end;
  225.  
  226.  
  227. e104c      = record
  228.               native : MyWord;
  229.               func   : byte; { will be 0, Send a Broadcast Message }
  230.               numstn : byte;
  231.               stnlst : byte; { can be more than 1, here though, only 1 }
  232.               meslen : byte;
  233.               messge : array[1..60] of byte;
  234.              end;
  235.  
  236. e104r      = record
  237.               native : MyWord;
  238.               numstn : byte;
  239.               stnlst : byte; { can be more than 1, here though, only 1 }
  240.              end;
  241.  
  242.  
  243. e336c      = record
  244.               native : MyWord;
  245.               func   : byte; { will be 0x36, Get an Object's Name }
  246.               objid  : Long;
  247.              end;
  248.  
  249. e336r      = record
  250.               native : MyWord;
  251.               Qid    : Long;
  252.               objtyp : MyWord;
  253.               objnme : array[1..48] of byte;
  254.              end;
  255.  
  256.  
  257. var
  258.  
  259. regs  : registers;
  260. CQc   : e364c; { Create Queue }
  261. CQr   : e364r;
  262.  
  263. GIc   : e335c; { Get an Object's ID }
  264. GIr   : e335r;
  265.  
  266.  
  267. a2gc  : e341c; { Add to (2) Group }
  268. a2gr  : e341r;
  269.  
  270. aE2gc : e341Ec;{ Add to (2) Group }
  271. aE2gr : e341Er;{ Add group EVERYONE to Q_USERS }
  272.  
  273.  
  274. AQc   : e36fc; { Attach to Queue }
  275. AQr   : e36fr;
  276.  
  277. SSc   : e377c; { Set queue Status }
  278. SSr   : e377r;
  279.  
  280. GLc   : e36bc; { Get queue List }
  281. GLr   : e36br;
  282.  
  283. SJc   : e371c; { Service queue Job }
  284. SJr   : e371r;
  285.  
  286. FJc   : e372c; { Finish service of Job }
  287. FJr   : e372r;
  288.  
  289. DQc   : e370c; { Detach from Queue }
  290. DQr   : e370r;
  291.  
  292. SMc   : e104c; { Send Message }
  293. SMr   : e104r;
  294.  
  295. GNc   : e336c; { Get Object Name }
  296. GNr   : e336r;
  297.  
  298. theQ  : Long;  { holds our Queue ID }
  299.  
  300. Queuetype : MyWord; { holds our Queue type }
  301.  
  302. a     : integer;
  303.  
  304. {*-*-*-*-*-*-*-*-*-*-*-*-* Procedures below *-*-*-*-*-*-*-*-*-*-*-*-*}
  305.  
  306. Procedure DisplayError(code:byte; routine:byte);
  307. Begin
  308.  
  309.  
  310.   Write('Error from ');
  311.   case routine of
  312.   1: Write('CreateQueue');
  313.   2: Write('AddSUPERVISOR');
  314.   3: Write('AttachQueue');
  315.   4: Write('SetStatus');
  316.   5: Write('GetList');
  317.   6: Write('ServiceJob');
  318.   7: Write('FinishJob');
  319.   8: Write('DetachQueue');
  320.   9: Write('AddEVERYONE');
  321.   10:Write('MessageBy');
  322.   end; { end of case }
  323.  
  324.  
  325.   Write('-> ');
  326.   case code of
  327.   $96: Writeln('Server out of memory');
  328.   $99: Writeln('Directory Full');
  329.   $9B: Writeln('Bad Directory Handle');
  330.   $9C: Writeln('Invalid Path');
  331.   $D0: Writeln('Queue Error');
  332.   $D1: Writeln('No Queue');
  333.   $D2: Writeln('No Queue server');
  334.   $D3: Writeln('No Queue rights');
  335.   $D5: Writeln('No Queue job');
  336.   $D6: Writeln('No Job rights');
  337.   $D9: Writeln('Station not server');
  338.   $DA: Writeln('Queue halted');
  339.   $DB: Writeln('Max Queue Servers reached');
  340.   $E9: Writeln('Member already exists in property');
  341.   $ED: Writeln('Property already exists');
  342.   $EE: Writeln('Object already exists');
  343.   $EF: Writeln('Invalid name');
  344.   $F0: Writeln('Wildcard not allowed');
  345.   $F1: Writeln('Invalid bindery security');
  346.   $F5: Writeln('No object create privilege');
  347.   $F7: Writeln('No propery create privilege');
  348.   $FC: Writeln('No such object');
  349.   $FE: Writeln('Server bindery locked');
  350.   $FF: Writeln('Bindery failure');
  351.  
  352.   else Writeln('<',code,'> - ? Unknown ?');
  353.   end; { end of case }
  354.  
  355.  
  356. End; { end of DisplayError }
  357.  
  358.  
  359.  
  360.  
  361. Procedure CreateQueue;
  362. Begin
  363.  
  364.  
  365.   with CQc do
  366.   begin
  367.     native.wh := 30;
  368.     native.wl := 0;
  369.     func      := $64;
  370.     Qtype.wh  := QueueType.wh; { Arbitrary }
  371.     Qtype.wl  := QueueType.wl;
  372.     QnameL    := 4;
  373.     Qname[1]  := 68; {D}
  374.     Qname[2]  := 69; {E}
  375.     Qname[3]  := 77; {M}
  376.     Qname[4]  := 79; {O}
  377.     dirhnd    := 0;  {0 means the full pathname will be specified minus servername}
  378.     pathL     := 10;
  379.     pathN[1]  := 83; {S}
  380.     pathN[2]  := 89; {Y}
  381.     pathN[3]  := 83; {S}
  382.     pathN[4]  := 58; {:}
  383.     pathN[5]  := 83; {S}
  384.     pathN[6]  := 89; {Y}
  385.     pathN[7]  := 83; {S}
  386.     pathN[8]  := 84; {T}
  387.     pathN[9]  := 69; {E}
  388.     pathN[10] := 77; {M}
  389.   end;
  390.  
  391.   CQr.native.wh := 4;
  392.   CQr.native.wl := 0;
  393.  
  394.   with regs do
  395.   begin
  396.     AX := $E300;
  397.     DS := Seg(CQc);
  398.     SI := Ofs(CQc);
  399.  
  400.     ES := Seg(CQr);
  401.     DI := Ofs(CQr);
  402.   end;
  403.  
  404.   MsDos(regs);
  405.  
  406.   if (regs.AL <> 0) and (regs.AL <> 238) then DisplayError(regs.AL, 1);
  407.  
  408.   if (regs.AL = 0) then
  409.   begin
  410.     theQ.a := CQr.Qid.a;
  411.     theQ.b := CQr.Qid.b;
  412.     theQ.c := CQr.Qid.c;
  413.     theQ.d := CQr.Qid.d;
  414.   end;
  415.  
  416.  
  417.   if (regs.AL = 238) then {Queue already exists, get its id}
  418.   begin
  419.     with GIc do
  420.     begin
  421.       native.wh := 8;
  422.       native.wl := 0;
  423.       func      := $35;
  424.       objtyp.wh := QueueType.wh; { must match type defined in CreateQueue [above] }
  425.       objtyp.wl := QueueType.wl;
  426.       objnml    := 4;
  427.       objnme[1] := 68; {D}
  428.       objnme[2] := 69; {E}
  429.       objnme[3] := 77; {M}
  430.       objnme[4] := 79; {O}
  431.     end;
  432.  
  433.     GIr.native.wh := 54;
  434.     GIr.native.wl := 0;
  435.  
  436.     with regs do
  437.      begin
  438.       AX := $E300;
  439.       DS := Seg(GIc);
  440.       SI := Ofs(GIc);
  441.  
  442.       ES := Seg(GIr);
  443.       DI := Ofs(GIr);
  444.      end;
  445.  
  446.   MsDos(regs);
  447.  
  448.   { presumed it worked }
  449.  
  450.   theQ.a := GIr.Qid.a;
  451.   theQ.b := GIr.Qid.b;
  452.   theQ.c := GIr.Qid.c;
  453.   theQ.d := GIr.Qid.d;
  454.  
  455.   end;
  456.  
  457.  
  458. End; { end of CreateQueue }
  459.  
  460.  
  461.  
  462.  
  463. Procedure AddSUPERVISOR;
  464. Begin
  465.  
  466.   With a2gc do
  467.   begin
  468.     native.wh := 31;
  469.     native.wl := 0;
  470.     func      := $41;
  471.     objtyp.wh := QueueType.wh; { same as Qtype in CreateQueue }
  472.     objtyp.wl := QueueType.wl;
  473.     objnml    := 4;
  474.     objnme[1] := 68; {D}
  475.     objnme[2] := 69; {E}
  476.     objnme[3] := 77; {M}
  477.     objnme[4] := 79; {O}
  478.     propl     := 9;
  479.     propn[1]  := 81; {Q}
  480.     propn[2]  := 95; {_}
  481.     propn[3]  := 83; {S}
  482.     propn[4]  := 69; {E}
  483.     propn[5]  := 82; {R}
  484.     propn[6]  := 86; {V}
  485.     propn[7]  := 69; {E}
  486.     propn[8]  := 82; {R}
  487.     propn[9]  := 83; {S}
  488.     memtyp.wh := 0;
  489.     memtyp.wl := 1; { regular USER type }
  490.     memnml    := 10;
  491.     memnme[1] := 83; {S}
  492.     memnme[2] := 85; {U}
  493.     memnme[3] := 80; {P}
  494.     memnme[4] := 69; {E}
  495.     memnme[5] := 82; {R}
  496.     memnme[6] := 86; {V}
  497.     memnme[7] := 73; {I}
  498.     memnme[8] := 83; {S}
  499.     memnme[9] := 79; {O}
  500.     memnme[10]:= 82; {R}
  501.   end;
  502.  
  503.   a2gr.native.wh:=1;
  504.   a2gr.native.wl:=0;
  505.  
  506.   with regs do
  507.   begin
  508.     AX := $E300;
  509.     DS := Seg(a2gc);
  510.     SI := Ofs(a2gc);
  511.  
  512.     ES := Seg(a2gr);
  513.     DI := Ofs(a2gr);
  514.   end;
  515.  
  516.   MsDos(regs);
  517.  
  518.   if (regs.AL <> 0) and (regs.AL <> 233) then DisplayError(regs.AL, 2);
  519.   { 233 = Member already exists in property }
  520.  
  521. End; { end of AddSUPERVISOR }
  522.  
  523.  
  524.  
  525.  
  526. Procedure AddEVERYONE;
  527. Begin
  528.  
  529.   With aE2gc do
  530.   begin
  531.     native.wh := 28;
  532.     native.wl := 0;
  533.     func      := $41;
  534.     objtyp.wh := QueueType.wh; { same as Qtype in CreateQueue }
  535.     objtyp.wl := QueueType.wl;
  536.     objnml    := 4;
  537.     objnme[1] := 68; {D}
  538.     objnme[2] := 69; {E}
  539.     objnme[3] := 77; {M}
  540.     objnme[4] := 79; {O}
  541.     propl     := 7;
  542.     propn[1]  := 81; {Q}
  543.     propn[2]  := 95; {_}
  544.     propn[3]  := 85; {U}
  545.     propn[4]  := 83; {S}
  546.     propn[5]  := 69; {E}
  547.     propn[6]  := 82; {R}
  548.     propn[7]  := 83; {S}
  549.     memtyp.wh := 0;
  550.     memtyp.wl := 2; { regular GROUP type }
  551.     memnml    := 8;
  552.     memnme[1] := 69; {E}
  553.     memnme[2] := 86; {V}
  554.     memnme[3] := 69; {E}
  555.     memnme[4] := 82; {R}
  556.     memnme[5] := 89; {Y}
  557.     memnme[6] := 79; {O}
  558.     memnme[7] := 78; {N}
  559.     memnme[8] := 69; {E}
  560.   end;
  561.  
  562.   aE2gr.native.wh:=1;
  563.   aE2gr.native.wl:=0;
  564.  
  565.   with regs do
  566.   begin
  567.     AX := $E300;
  568.     DS := Seg(aE2gc);
  569.     SI := Ofs(aE2gc);
  570.  
  571.     ES := Seg(aE2gr);
  572.     DI := Ofs(aE2gr);
  573.   end;
  574.  
  575.   MsDos(regs);
  576.  
  577.   if (regs.AL <> 0) and (regs.AL <> 233) then DisplayError(regs.AL, 9);
  578.   { 233 = Member already exists in property }
  579.  
  580. End; { end of AddEVERYONE }
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587. Procedure AttachQueue;
  588. Begin
  589.  
  590.   with AQc do
  591.   begin
  592.     native.wh := 5;
  593.     native.wl := 0;
  594.     func      := $6F;
  595.     Qid.a     := theQ.a;
  596.     Qid.b     := theQ.b;
  597.     Qid.c     := theQ.c;
  598.     Qid.d     := theQ.d;
  599.   end;
  600.  
  601.   AQr.native.wh := 1;
  602.   AQr.native.wl := 0;
  603.  
  604.   with regs do
  605.   begin
  606.     AX := $E300;
  607.     DS := Seg(AQc);
  608.     SI := Ofs(AQc);
  609.  
  610.     ES := Seg(AQr);
  611.     DI := Ofs(AQr);
  612.   end;
  613.  
  614.   MsDos(regs);
  615.  
  616.   if (regs.AL <> 0) then DisplayError(regs.AL, 3)
  617.   else
  618.   Writeln('Successfully Attached to Queue DEMO');
  619.  
  620. End; { end of AttachQueue }
  621.  
  622.  
  623.  
  624.  
  625. Procedure SetStatus;
  626. Begin
  627.  
  628.   with SSc do
  629.   begin
  630.     native.wh := 69;
  631.     native.wl := 0;
  632.     func      := $77;
  633.     Qid.a     := theQ.a;
  634.     Qid.b     := theQ.b;
  635.     Qid.c     := theQ.c;
  636.     Qid.d     := theQ.d;
  637.     charge[1] := 0;
  638.     charge[2] := 0;
  639.     charge[3] := 0;
  640.     charge[4] := 0;
  641.     status    := 'This is a demo Queue Server';
  642.   end;
  643.  
  644.   SSr.native.wh := 1;
  645.   SSr.native.wl := 0;
  646.  
  647.   with regs do
  648.   begin
  649.     AX := $E300;
  650.     DS := Seg(SSc);
  651.     SI := Ofs(SSc);
  652.  
  653.     ES := Seg(SSr);
  654.     DI := Ofs(SSr);
  655.   end;
  656.  
  657.   MsDos(regs);
  658.  
  659.   if (regs.AL <> 0) then DisplayError(regs.AL, 4);
  660.  
  661. End; { end of SetStatus }
  662.  
  663.  
  664.  
  665.  
  666. Procedure GetList;
  667. Begin
  668.  
  669.   with GLc do
  670.   begin
  671.     native.wh := 5;
  672.     native.wl := 0;
  673.     func      := $6B;
  674.     Qid.a     := theQ.a;
  675.     Qid.b     := theQ.b;
  676.     Qid.c     := theQ.c;
  677.     Qid.d     := theQ.d;
  678.   end;
  679.  
  680.   GLr.native.wh := $F8;
  681.   GLr.native.wl := $01; {504 or 0x1F8}
  682.  
  683.   with regs do
  684.   begin
  685.     AX := $E300;
  686.     DS := Seg(GLc);
  687.     SI := Ofs(GLc);
  688.  
  689.     ES := Seg(GLr);
  690.     DI := Ofs(GLr);
  691.   end;
  692.  
  693.   MsDos(regs);
  694.  
  695.   if (regs.AL <> 0) then DisplayError(regs.AL, 5);
  696.  
  697.  
  698. End; { end of GetList }
  699.  
  700.  
  701.  
  702. Procedure FinishJob(jobnumber:MyWord);FORWARD;
  703. Procedure MessageBy(submit:Long);FORWARD;
  704. Procedure SendMessage(request:char60; len:integer);FORWARD;
  705.  
  706.  
  707. Procedure ServiceJob;
  708. var
  709. NETQ    : string[5];
  710. request : char60;
  711. a       : integer;
  712. filehan : integer;
  713. bytes2read : integer;
  714. Begin
  715.  
  716.   with SJc do
  717.   begin
  718.     native.wh := 7;
  719.     native.wl := 0;
  720.     func      := $71;
  721.     Qid.a     := theQ.a;
  722.     Qid.b     := theQ.b;
  723.     Qid.c     := theQ.c;
  724.     Qid.d     := theQ.d;
  725.     Target.wh := $FF;
  726.     Target.wl := $FF;
  727.   end;
  728.  
  729.   SJr.native.wh := 54;
  730.   SJr.native.wl := 0;
  731.  
  732.   with regs do
  733.   begin
  734.     AX := $E300;
  735.     DS := Seg(SJc);
  736.     SI := Ofs(SJc);
  737.  
  738.     ES := Seg(SJr);
  739.     DI := Ofs(SJr);
  740.   end;
  741.  
  742.   MsDos(regs);
  743.  
  744.  
  745.   if (regs.AL <> 213) then  { no queue job, this will occur when someone opens
  746.                             { a queue job but hasn't closed it yet...}
  747.   Writeln;
  748.  
  749.  
  750.   if (regs.AL <> 213) then { repeated because I'd rather not indent some more...! }
  751.   if (regs.AL <> 0) then DisplayError(regs.AL, 6)
  752.   else
  753.   begin
  754.  
  755.     with SJr do
  756.     Writeln('Job Submitted by ID [',cltID.a,'][',cltID.b,'][',cltID.c,'][',cltID.d,']');
  757.  
  758.     MessageBy(SJr.cltID);
  759.  
  760.  
  761.     regs.AX := $3D02;
  762.     NETQ    := 'NETQ'^@;
  763.     regs.DS := Seg(NETQ);
  764.     regs.DX := Ofs(NETQ)+1;
  765.  
  766.     MsDos(regs);
  767.  
  768.     Writeln('File Handle from open NETQ = [',regs.AX,']');
  769.  
  770.  
  771.     filehan := regs.AX;
  772.  
  773.     bytes2read := 57;
  774.     regs.AX := $3F00;
  775.     regs.BX := filehan;
  776.     regs.CX := bytes2read;
  777.     regs.DS := Seg(request);
  778.     regs.DX := Ofs(request);
  779.  
  780.     MsDos(regs);
  781.  
  782.     {
  783.       byte  0     = logical station number to send to
  784.       bytes 1..56 = message to send
  785.     }
  786.  
  787.     if (regs.AX > 1) then
  788.      SendMessage(request,regs.AX)
  789.      else
  790.      Writeln('Job is of 0 length, nothing to process...');
  791.  
  792.     regs.AX := $3E00;
  793.     regs.BX := filehan;
  794.  
  795.     MsDos(regs);
  796.  
  797.     FinishJob(SJr.jobnum);
  798.  
  799.   end;
  800.  
  801.  
  802. End; { end of ServiceJob }
  803.  
  804.  
  805.  
  806.  
  807.  
  808. Procedure MessageBy;
  809. var
  810. a : integer;
  811. Begin
  812.  
  813.   with GNc do
  814.   begin
  815.     native.wh := 5;
  816.     native.wl := 0;
  817.     func      := $36;
  818.     objid.a   := submit.a;
  819.     objid.b   := submit.b;
  820.     objid.c   := submit.c;
  821.     objid.d   := submit.d;
  822.   end;
  823.  
  824.   GNr.native.wh := 54;
  825.   GNr.native.wl := 0;
  826.  
  827.   with regs do
  828.   begin
  829.     AX := $E300;
  830.     DS := Seg(GNc);
  831.     SI := Ofs(GNc);
  832.  
  833.     ES := Seg(GNr);
  834.     DI := Ofs(GNr);
  835.   end;
  836.  
  837.   MsDos(regs);
  838.  
  839.   if (regs.AL <> 0) then DisplayError(regs.AL, 10)
  840.   else
  841.   begin
  842.     Write('Processing job from: [');
  843.     regs.AX := $0900;
  844.     regs.DS := Seg(GNr.objnme);
  845.     regs.DX := Ofs(GNr.objnme);
  846.  
  847.     for a:=1 to 48 do
  848.      if (GNr.objnme[a]=0) then GNr.objnme[a] := ord('$');
  849.  
  850.     MsDos(regs);
  851.     Writeln(']');
  852.   end;
  853.  
  854.  
  855. End; { end of MessageBy }
  856.  
  857.  
  858.  
  859.  
  860.  
  861. Procedure SendMessage;
  862. var
  863. a : integer;
  864. Begin
  865.  
  866.   if (len>57) then len:=57;
  867.  
  868.   with SMc do
  869.   begin
  870.     native.wh := 4+len-1;
  871.     native.wl := 0;
  872.     func      := 0;
  873.     numstn    := 1;
  874.     meslen    := len-1;
  875.     stnlst    := request[0];
  876.     a:=1;
  877.     while (a<(len)) do
  878.     begin
  879.       if (request[a]<>0) then messge[a] := request[a]
  880.       else
  881.       begin
  882.         meslen    := a-1;
  883.         native.wh := 4+meslen;
  884.       end;
  885.       a:=a+1;
  886.     end;
  887.   end;
  888.  
  889.   SMr.native.wh := 2;
  890.   SMr.native.wl := 0;
  891.  
  892.   with regs do
  893.   begin
  894.     AX := $E100;
  895.     DS := Seg(SMc);
  896.     SI := Ofs(SMc);
  897.  
  898.     ES := Seg(SMr);
  899.     DI := Ofs(SMr);
  900.   end;
  901.  
  902.   MsDos(regs);
  903.  
  904.   if (regs.AL <> 0) then Write('Unable to send message ')
  905.   else
  906.   Write('Message sent ');
  907.  
  908.   Writeln('to station [',request[0],']');
  909.  
  910. End; { end of SendMessage }
  911.  
  912.  
  913.  
  914.  
  915.  
  916. Procedure FinishJob;
  917. Begin
  918.  
  919.   with FJc do
  920.   begin
  921.     native.wh := 11;
  922.     native.wl := 0;
  923.     func      := $72;
  924.     Qid.a     := theQ.a;
  925.     Qid.b     := theQ.b;
  926.     Qid.c     := theQ.c;
  927.     Qid.d     := theQ.d;
  928.     jobnum.wh := jobnumber.wh;
  929.     jobnum.wl := jobnumber.wl;
  930.     charge.a  := 0;
  931.     charge.b  := 0;
  932.     charge.c  := 0;
  933.     charge.d  := 0;
  934.   end;
  935.  
  936.   FJr.native.wh := 1;
  937.   FJr.native.wl := 0;
  938.  
  939.   with regs do
  940.   begin
  941.     AX := $E300;
  942.     DS := Seg(FJc);
  943.     SI := Ofs(FJc);
  944.  
  945.     ES := Seg(FJr);
  946.     DI := Ofs(FJr);
  947.   end;
  948.  
  949.   MsDos(regs);
  950.  
  951.   if (regs.AL <> 0) then DisplayError(regs.AL, 7);
  952.  
  953. End; { end of FinishJob }
  954.  
  955.  
  956.  
  957.  
  958. Procedure DetachQueue;
  959. Begin
  960.  
  961.   with DQc do
  962.   begin
  963.     native.wh := 5;
  964.     native.wl := 0;
  965.     func      := $70;
  966.     Qid.a     := theQ.a;
  967.     Qid.b     := theQ.b;
  968.     Qid.c     := theQ.c;
  969.     Qid.d     := theQ.d;
  970.   end;
  971.  
  972.   DQr.native.wh := 1;
  973.   DQr.native.wl := 0;
  974.  
  975.   with regs do
  976.   begin
  977.     AX := $E300;
  978.     DS := Seg(DQc);
  979.     SI := Ofs(DQc);
  980.  
  981.     ES := Seg(DQr);
  982.     DI := Ofs(DQr);
  983.   end;
  984.  
  985.   MsDos(regs);
  986.  
  987.   if (regs.AL <> 0) then DisplayError(regs.AL, 8)
  988.   else
  989.   Writeln('Successfully detached from Queue DEMO');
  990.  
  991. End; { end of DetachQueue }
  992.  
  993.  
  994.  
  995. Begin
  996.  
  997.  
  998.      QueueType.wh := 3;
  999.      QueueType.wl := 3;  { this is an arbitrary queue type... 0x0303 }
  1000.  
  1001.      clrscr;
  1002.  
  1003.  
  1004.      CreateQueue;
  1005.  
  1006.      Writeln('Qid is [',theQ.a,'][',theQ.b,'][',theQ.c,'][',theQ.d,']');
  1007.  
  1008.      AddSUPERVISOR;
  1009.  
  1010.      AddEVERYONE;
  1011.  
  1012.  
  1013.  
  1014.      AttachQueue;
  1015.  
  1016.      SetStatus;
  1017.  
  1018.      repeat
  1019.  
  1020.       GetList;
  1021.  
  1022.       Write('Number of jobs in queue [',GLr.jobcnt.wl,']');
  1023.  
  1024.       if (GLr.jobcnt.wl>0) then
  1025.       begin
  1026.         ServiceJob;
  1027.         if (regs.AL = 213) then for a:=1 to 40 do write(#8)
  1028.         else
  1029.         writeln('─────» end of job processing «─────');
  1030.       end
  1031.       else
  1032.         for a:=1 to 40 do write(#8);
  1033.  
  1034.  
  1035.       delay(1000*15); { 15 second delay, you can vary this... }
  1036.  
  1037.      until keypressed;
  1038.  
  1039.      DetachQueue;
  1040.  
  1041.  
  1042. End.